﻿<!--#include file="lib/base.asp"-->
<!--#include file="lib/sha1.asp"-->
<%
	dim signature,nonce,timestamp,Token,echostr
	dim xml_dom,StrSend
	dim ToUserName,FromUserName,CreateTime,MsgType,MsgId
	dim Content,MediaId,PicUrl,Format,ThumbMediaId,Location_X,Location_Y,Scale,Label,Title,Descriptions,Url,EventKey
	dim BeiZhu
	
	signature = Request("signature")
	nonce = Request("nonce")
	timestamp = Request("timestamp")
	echostr=request("echostr")
	
	'验证微信接口
	If echostr<>"" then
		dim datadb:datadb=Cls.db.dbload("","Token","[sys_Config]","id=1","")
		dim str,M
		dim Myarray:Myarray=Sort(Array(datadb(0,0),timestamp,nonce))
		For M=0 To Ubound(Myarray)
			str=str&Myarray(M)
		Next
		if signature=Lcase(sha1(str)) then
			cls.echo echostr
			cls.die
		end if
	End if
	
	'接收微信发过来的消息并返回消息到微信
	call GetXmlData()
	response.Write StrSend	
	
	'获取微信主动发送过来的内容
	Sub GetXmlData	
		set xml_dom = Server.CreateObject("MSXML2.DOMDocument")
		if xml_dom.load(request)=false then
			Response.End()	'判断是否由微信Post正确的XML数据过来
		else
			ToUserName=xml_dom.getelementsbytagname("ToUserName").item(0).text '接收者微信账号。即我们的公众平台账号。
			FromUserName=xml_dom.getelementsbytagname("FromUserName").item(0).text '发送者微信账号。
			CreateTime=xml_dom.getelementsbytagname("CreateTime").item(0).text
			MsgType=xml_dom.getelementsbytagname("MsgType").item(0).text
			if (MsgType="event") then
				strEventType=xml_dom.getelementsbytagname("Event").item(0).text '微信事件
				if strEventType="subscribe" then '表示订阅微信公众平台
						BeiZhu="用户关注"
						Content="用户关注"
						Call AddMsg()
						StrSend=GetSubscribeBack()
				ElseIf strEventType="unsubscribe" Then'取消关注
						BeiZhu="取消关注"
						Content="取消关注"
						Call AddMsg()
				ElseIf strEventType="CLICK" Then'点击菜单获取关键字
						EventKey=xml_dom.getelementsbytagname("EventKey").item(0).text
						Content=EventKey
						BeiZhu="点击菜单获取关键字"
						Call AddMsg()
						StrSend=GetPicMsgBack(EventKey)
				ElseIf strEventType="VIEW" Then'点击菜单获取关键字
						EventKey=xml_dom.getelementsbytagname("EventKey").item(0).text
						Content=EventKey
						BeiZhu="点击菜单跳转网址"
						Call AddMsg()
				end if
			else
				MsgId=xml_dom.getelementsbytagname("MsgId").item(0).text
			End If
			If MsgType="text" then
				Content=xml_dom.getelementsbytagname("Content").item(0).text
				'StrSend=RequestSendText(FromUserName,ToUserName,"你这发的是文本消息啊："&Content)
				BeiZhu="接收文本信息"
				Call AddMsg()
				StrSend=GetPicMsgBack(Content)
			elseif MsgType="image" then
				MediaId=xml_dom.getelementsbytagname("MediaId").item(0).text
				PicUrl=xml_dom.getelementsbytagname("PicUrl").item(0).text
				'StrSend=RequestSendText(FromUserName,ToUserName,"你发的是图片？"&PicUrl)
				Content=PicUrl
				BeiZhu="接收图片信息"
				Call AddMsg()
			elseif MsgType="voice" then
				MediaId=xml_dom.getelementsbytagname("MediaId").item(0).text
				Format=xml_dom.getelementsbytagname("Format").item(0).text
				'StrSend=RequestSendText(FromUserName,ToUserName,"你发的是声音？")
				BeiZhu="接收语音信息"
				Call AddMsg()
			elseif MsgType="video" then
				MediaId=xml_dom.getelementsbytagname("MediaId").item(0).text
				ThumbMediaId=xml_dom.getelementsbytagname("ThumbMediaId").item(0).text
				'StrSend=RequestSendText(FromUserName,ToUserName,"你发的是视频？")
				BeiZhu="接收视频信息"
				Call AddMsg()
			elseif MsgType="location" then
				Location_X=xml_dom.getelementsbytagname("Location_X").item(0).text
				Location_Y=xml_dom.getelementsbytagname("Location_Y").item(0).text
				Scale=xml_dom.getelementsbytagname("Scale").item(0).text
				Label=xml_dom.getelementsbytagname("Label").item(0).text
				'StrSend=RequestSendText(FromUserName,ToUserName,"你发的是地址信息？"&Label)
				BeiZhu="接收位置信息"
			elseif MsgType="link" then
				Title=xml_dom.getelementsbytagname("Title").item(0).text
				Descriptions=xml_dom.getelementsbytagname("Description").item(0).text
				Url=xml_dom.getelementsbytagname("Url").item(0).text
				'StrSend=RequestSendText(FromUserName,ToUserName,"你发的是链接？")
				Content=Url
				BeiZhu="接收链接信息"
				Call AddMsg()
			end if	
			set xml_dom=Nothing
		end if
				
	End Sub
	
	
	Sub AddMsg()'消息入库
		Dim StrSQL
		If MsgId = "" Then
			StrSQL = "1 = 1" 
		Else 
			StrSQL = "MsgId = '"& MsgId &"'"
		End If
		SQL = "select top 1 * from [sys_Msg] where "& StrSQL
		Set Rs = Server.CreateObject("Adodb.RecordSet")
		Rs.Open SQL,Conn,1,3
		If MsgId <> "" And Not (Rs.BOF And Rs.EOF) Then '所入库消息存在，直接退出
			Rs.Close
			Set Rs = nothing
			Exit Sub
		End if
		Rs.addnew
		Rs("ToUserName")   = ToUserName
		Rs("FromUserName") = FromUserName
		Rs("CreateTime")   = FromUnixTime(CreateTime)
		Rs("MsgType")      = MsgType
		Rs("MsgId")        = MsgId
		Rs("Content")      = Content
		Rs("MediaId")      = MediaId
		Rs("PicUrl")       = PicUrl
		Rs("Format")       = Format
		Rs("ThumbMediaId") = ThumbMediaId
		Rs("Location_X")   = Location_X
		Rs("Location_Y")   = Location_Y
		Rs("Scale")        = Scale
		Rs("Label")        = Label
		Rs("Title")        = Title
		Rs("Url")          = Url
		Rs("BeiZhu")       = BeiZhu
		Rs("AddTime")      = Now()
		Rs.Update
		Rs.Close
		Set Rs = Nothing
	End Sub
	'字典排序
	Function Sort(ary)
		Dim KeepChecking,I,FirstValue,SecondValue
		KeepChecking = TRUE 
		Do Until KeepChecking = FALSE 
		KeepChecking = FALSE 
		For I = 0 to UBound(ary) 
		If I = UBound(ary) Then Exit For 
		If ary(I) > ary(I+1) Then 
		FirstValue = ary(I) 
		SecondValue = ary(I+1) 
		ary(I) = SecondValue 
		ary(I+1) = FirstValue 
		KeepChecking = TRUE 
		End If 
		Next 
		Loop 
		Sort = ary 
	End Function 
%>